home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 26 / AACD 26.iso / AACD / Programming / ace_gpl_release / src / ace / c / file.c < prev    next >
Encoding:
C/C++ Source or Header  |  1998-10-04  |  17.5 KB  |  806 lines
  1. /* << ACE >>
  2.  
  3.    -- Amiga BASIC Compiler --
  4.  
  5.    ** Parser: file functions **
  6.    ** Copyright (C) 1998 David Benn
  7.    ** 
  8.    ** This program is free software; you can redistribute it and/or
  9.    ** modify it under the terms of the GNU General Public License
  10.    ** as published by the Free Software Foundation; either version 2
  11.    ** of the License, or (at your option) any later version.
  12.    **
  13.    ** This program is distributed in the hope that it will be useful,
  14.    ** but WITHOUT ANY WARRANTY; without even the implied warranty of
  15.    ** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16.    ** GNU General Public License for more details.
  17.    **
  18.    ** You should have received a copy of the GNU General Public License
  19.    ** along with this program; if not, write to the Free Software
  20.    ** Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
  21.  
  22.    Author: David J Benn
  23.      Date: 26th October-30th November, 1st-13th December 1991,
  24.        14th,20th-27th January 1992, 
  25.            2nd-17th, 21st-29th February 1992, 
  26.        1st,13th,14th,22nd,23rd March 1992,
  27.        21st,22nd April 1992,
  28.        2nd,3rd,11th,15th,16th May 1992,
  29.        7th,8th,9th,11th,13th,14th,28th,29th,30th June 1992,
  30.        2nd-8th,14th-19th,26th-29th July 1992,
  31.        1st-3rd,7th,8th,9th August 1992,
  32.        6th,7th December 1992,
  33.        4th,5th,6th January 1993,
  34.        12th,14th,15th February 1993,
  35.        1st March 1993,
  36.        9th,17th,18th May 1993,
  37.        15th December 1993,
  38.        2nd January 1994,
  39.        11th March 1995,
  40.        10th March 1996
  41. */
  42.  
  43. #include "acedef.h"
  44.  
  45. /* locals */
  46. static     char    *frame_ptr[] = { "(a4)", "(a5)" };
  47.     
  48. /* externals */
  49. extern    int    lev;
  50. extern    int    sym;
  51. extern    int    obj;
  52. extern    int    typ;
  53. extern    BOOL    end_of_source;
  54. extern    SYM    *curr_item;
  55. extern    char    id[MAXIDSIZE];
  56. extern    char    tempstrname[80];
  57.     
  58. /* functions */
  59. void open_a_file()
  60. {
  61.  /* OPEN mode,[#]filenumber,filespec */
  62.  
  63.  check_for_event();
  64.  
  65.  insymbol();
  66.  if (expr() != stringtype) _error(4);  /* mode = I, O or A */
  67.  else
  68.  {
  69.   if (sym != comma) _error(16);
  70.   else
  71.   {
  72.    insymbol();
  73.    if (sym == hash) insymbol(); /* # filenumber */
  74.    if (make_integer(expr()) == shorttype) 
  75.       make_long(); /* 1..255 */
  76.    if (sym != comma) _error(16);
  77.    else
  78.    {
  79.     insymbol();
  80.     if (expr() != stringtype) _error(4);  /* filespec */
  81.     else
  82.     {
  83.      /* pop arguments */
  84.      gen("move.l","(sp)+","a1");  /* address of filespec */
  85.      gen("move.l","(sp)+","d0");  /* filenumber */
  86.      gen("move.l","(sp)+","a0");  /* address of mode string */
  87.  
  88.      gen("jsr","_openfile","  ");
  89.      enter_XREF("_openfile");
  90.      enter_XREF("_DOSBase");
  91.     }
  92.    }
  93.   }
  94.  }    
  95. }
  96.  
  97. void close_a_file()
  98. {
  99.  /* CLOSE [#]filenumber[,[#]filenumber..] */
  100.  
  101.  check_for_event();
  102.  
  103.  do
  104.  {
  105.   insymbol();
  106.   if (sym == hash) insymbol(); 
  107.   if (make_integer(expr()) == shorttype) 
  108.      make_long(); /* filenumber = 1..255 */
  109.  
  110.   gen("move.l","(sp)+","d0");
  111.   gen("jsr","_closefile","  ");
  112.  }
  113.  while (sym == comma);
  114.  
  115.  enter_XREF("_closefile");
  116.  enter_XREF("_DOSBase");
  117. }
  118.  
  119. void line_input()
  120. {
  121. char addrbuf[40];
  122. SYM  *storage;
  123.  
  124.  /* LINE INPUT  [;][prompt-string;]string-variable
  125.     LINE INPUT# filenumber;string-variable
  126.  
  127.     Note: only the latter is currently implemented.
  128.  */
  129.  
  130.  check_for_event();
  131.  
  132.  insymbol();
  133.  
  134.  if (sym != hash) _error(44);
  135.  else
  136.  {
  137.   insymbol();
  138.  
  139.   if (make_integer(expr()) == shorttype) 
  140.      make_long();  /* filenumber = 1..255 */
  141.  
  142.   if (sym != comma) _error(16);
  143.   else
  144.   {
  145.    insymbol();
  146.  
  147.    if (sym == ident && obj == variable)
  148.    {
  149.     /* if string variable/array doesn't exist, create a simple variable */
  150.     if (!exist(id,variable) && !exist(id,array)) 
  151.     {
  152.      /* allocate a simple string variable */
  153.      enter(id,typ,obj,0);
  154.      enter_DATA("_nullstring:","dc.b 0");
  155.      gen("pea","_nullstring","  ");
  156.      assign_to_string_variable(curr_item,MAXSTRLEN);
  157.     }
  158.  
  159.     storage=curr_item;
  160.  
  161.     /* is it a string variable or array? */
  162.     if (storage->type != stringtype) _error(4);
  163.     else    
  164.     {
  165.      /* get address of string pointed to by variable/array element */
  166.      itoa(-1*storage->address,addrbuf,10);
  167.      strcat(addrbuf,frame_ptr[lev]);
  168.  
  169.      /* pass filenumber (d0) and string address (a0) to function */
  170.      if (storage->object == array)
  171.      {
  172.       point_to_array(storage,addrbuf);
  173.       gen("move.l",addrbuf,"a0");
  174.       gen("adda.l","d7","a0");
  175.      }
  176.      else
  177.            gen("move.l",addrbuf,"a0");    /* string address */
  178.       
  179.      gen("move.l","(sp)+","d0");    /* filenumber */
  180.  
  181.      /* call _line_input */
  182.      gen("jsr","_line_input","  ");
  183.      enter_XREF("_line_input"); 
  184.  
  185.      insymbol();
  186.      if (sym == lparen && storage->object != array) 
  187.     _error(71);  /* undeclared array */
  188.     }
  189.    }
  190.    else _error(19); /* variable (or array) expected */
  191.   }
  192.  }
  193. }
  194.  
  195. void write_to_file()
  196. {
  197. int wtype;
  198.  
  199.  /* WRITE #filenumber,expression-list */
  200.  
  201.  check_for_event();
  202.  
  203.  insymbol();
  204.  
  205.  if (sym != hash) _error(44);
  206.  else
  207.  {
  208.   insymbol();
  209.  
  210.   if (make_integer(expr()) == shorttype) 
  211.      make_long();  /* filenumber = 1..255 */
  212.  
  213.   gen("move.l","(sp)+","_seq_filenumber");
  214.   
  215.   if (sym != comma) _error(16);
  216.   else
  217.   {
  218.    /* get expressions */
  219.    do
  220.    {
  221.     insymbol();
  222.     wtype=expr(); 
  223.  
  224.     switch(wtype)
  225.     {
  226.      case undefined : _error(0);  /* expression expected */ 
  227.               break;
  228.  
  229.      case shorttype :     gen("move.w","(sp)+","d1");
  230.                    gen("move.l","_seq_filenumber","d0");
  231.                   gen("jsr","_writeshort","  ");
  232.                   enter_XREF("_writeshort");
  233.                   break;
  234.  
  235.      case longtype :     gen("move.l","(sp)+","d1");
  236.                  gen("move.l","_seq_filenumber","d0");
  237.                  gen("jsr","_writelong","  ");
  238.                  enter_XREF("_writelong");
  239.                  break;
  240.  
  241.      case singletype :     gen("move.l","(sp)+","d1");
  242.                    gen("move.l","_seq_filenumber","d0");
  243.                    gen("jsr","_writesingle","  ");
  244.                    enter_XREF("_writesingle");
  245.             enter_XREF("_MathBase");
  246.                    break;
  247.  
  248.      case stringtype :     gen("move.l","_seq_filenumber","d0");
  249.             gen("jsr","_writequote","  ");    
  250.                    gen("move.l","(sp)+","a0");
  251.                    gen("move.l","_seq_filenumber","d0");
  252.                    gen("jsr","_writestring","  ");
  253.                    gen("move.l","_seq_filenumber","d0");
  254.                    gen("jsr","_writequote","  ");
  255.                    enter_XREF("_writequote");    
  256.                    enter_XREF("_writestring");        
  257.                    break;
  258.     }
  259.     
  260.     /* need a delimiter? */
  261.     if (sym == comma) 
  262.     { 
  263.      gen("move.l","_seq_filenumber","d0");
  264.      gen("jsr","_writecomma","  "); 
  265.      enter_XREF("_writecomma"); 
  266.     }
  267.  
  268.    }
  269.    while (sym == comma);  
  270.  
  271.    /* write LF to mark EOLN */
  272.    gen("move.l","_seq_filenumber","d0");
  273.    gen("jsr","_write_eoln","  ");
  274.    enter_XREF("_write_eoln");
  275.    
  276.    enter_XREF("_DOSBase");
  277.    enter_BSS("_seq_filenumber:","ds.l 1");
  278.   }
  279.  }
  280. }
  281.  
  282. void gen_writecode(code)
  283. int code;
  284. {
  285.  /* write special character sequence to a file */
  286.  
  287.  check_for_event();
  288.  
  289.  gen("move.l","_seq_filenumber","d0");
  290.  
  291.  switch(code)
  292.  {
  293.   /* LF */
  294.   case LF_CODE :     gen("jsr","_write_eoln","  ");
  295.               enter_XREF("_write_eoln");
  296.              break;
  297.   /* TAB */
  298.   case TAB_CODE :      gen("jsr","_writeTAB","  ");
  299.              enter_XREF("_writeTAB");
  300.             break;
  301.   /* SPACE */
  302.   case SPACE_CODE :    gen("jsr","_writeSPC","  ");
  303.              enter_XREF("_writeSPC");
  304.             break;
  305.  }
  306. }
  307.  
  308. void print_to_file()
  309. {
  310. int exprtype,arguments=0;
  311.  
  312.  /* PRINT #filenumber,expression-list */
  313.  
  314.  check_for_event();
  315.  
  316.  insymbol();
  317.  
  318.  if (make_integer(expr()) == shorttype)
  319.     make_long();    /* filenumber 1..255 */
  320.  
  321.  gen("move.l","(sp)+","_seq_filenumber");
  322.  enter_BSS("_seq_filenumber:","ds.l 1");
  323.  
  324.  if (sym != comma) _error(16);
  325.  else
  326.  {
  327.   do
  328.   {
  329.    if (sym != ident && !strfunc() && !numfunc() && !factorfunc() && 
  330.        obj != constant) 
  331.       insymbol(); /* ident/func/literal after a space or as first parameter */
  332.  
  333.    /* end of line, multi-statement, ";", "," ELSE or comment 
  334.       after "PRINT #filenumber," ? -> don't proceed to expr! */
  335.  
  336.       if ((sym == endofline) || (sym == colon) || (sym == apostrophe) || 
  337.           (sym == semicolon) || (sym == comma) || (sym == elsesym) ||
  338.       (end_of_source))
  339.       {
  340.        if (sym == comma) gen_writecode(TAB_CODE);
  341.        else
  342.        if ((arguments == 0) && (sym != semicolon)) 
  343.           gen_writecode(LF_CODE);  /* "PRINT #filenumber," with no args */ 
  344.  
  345.        if (sym != colon && sym != elsesym) 
  346.        insymbol();  /* leave colon for multi-statement 
  347.                        in statement() or leave ELSE for if_statement() */
  348.        return;
  349.       }
  350.  
  351.       /* get an expression */
  352.       exprtype = expr();
  353.    
  354.       if (exprtype == undefined) { _error(0); return; } /* illegal syms? */
  355.  
  356.       /* pass filenumber to write routine */
  357.       if (exprtype == stringtype) 
  358.      gen("move.l","_seq_filenumber","d0");
  359.       else
  360.      gen("move.l","_seq_filenumber","d1");
  361.  
  362.       switch(exprtype)
  363.       {
  364.            case shorttype :     gen("move.w","(sp)+","d0");
  365.                      gen("jsr","_fprintshort","  ");
  366.                       enter_XREF("_fprintshort");
  367.                      break;
  368.  
  369.         case longtype :        gen("move.l","(sp)+","d0");  
  370.                      gen("jsr","_fprintlong","  ");
  371.                      enter_XREF("_fprintlong");
  372.                      break;
  373.  
  374.       case singletype :     gen("move.l","(sp)+","d0");
  375.                      gen("jsr","_fprintsingle","  ");
  376.                      enter_XREF("_fprintsingle");
  377.                      enter_XREF("_MathBase");
  378.                      break;
  379.  
  380.        case stringtype :     gen("movea.l","(sp)+","a0");
  381.                      gen("jsr","_writestring","  ");
  382.                      enter_XREF("_writestring");
  383.                      break;
  384.       }
  385.  
  386.       if (exprtype != stringtype) 
  387.          gen_writecode(SPACE_CODE); /* trailing space for any number */
  388.  
  389.       arguments++;
  390.  
  391.       if (sym == comma) gen_writecode(TAB_CODE);
  392.    
  393.   }
  394.   while ((sym == comma) || (sym == semicolon) || (sym == ident) ||
  395.        strfunc() || numfunc() || factorfunc() || obj == constant);  
  396.  
  397.   /* no comma or semicolon at end of PRINT# -> LF */
  398.   gen_writecode(LF_CODE);
  399.  }
  400. }
  401.  
  402. void input_from_file()
  403. {
  404. int  inptype;
  405. char addrbuf[80];
  406. SYM  *storage;
  407.  
  408.  /* INPUT #filenumber,variable-list */
  409.  
  410.  check_for_event();
  411.  
  412.  insymbol();
  413.  
  414.  if (make_integer(expr()) == shorttype)
  415.     make_long();    /* filenumber 1..255 */
  416.  
  417.  gen("move.l","(sp)+","_seq_filenumber");
  418.  enter_BSS("_seq_filenumber:","ds.l 1");
  419.  
  420.  if (sym != comma) _error(16);
  421.  else
  422.  {
  423.   do
  424.   { 
  425.    /* allocate variable storage, call _input* and store value in variable */
  426.  
  427.    insymbol();
  428.  
  429.    if ((sym == ident) && (obj == variable))
  430.    {
  431.     if ((!exist(id,obj)) && (!exist(id,array)))
  432.        enter(id,typ,obj,0);  /* allocate storage for a simple variable */
  433.  
  434.     storage = curr_item;
  435.  
  436.     itoa(-1*storage->address,addrbuf,10);
  437.     strcat(addrbuf,frame_ptr[lev]); 
  438.   
  439.     /* ALL data types need a temporary string pointer in a1 */
  440.     make_temp_string();
  441.     gen("lea",tempstrname,"a0");  /* unique temp holder */
  442.  
  443.     /* when storing an input value into an array element, must save
  444.        value (d0) first, since array index calculation may be corrupted
  445.        if index has to be coerced from ffp to short.
  446.     */
  447.  
  448.     /* pass file number */
  449.     gen("move.l","_seq_filenumber","d0");
  450.      
  451.     switch(storage->type)
  452.     {
  453.     case shorttype  : gen("jsr","_finputshort","  ");
  454.  
  455.               if (storage->object == variable)
  456.               {
  457.                if ((storage->shared) && (lev == ONE))
  458.                {
  459.                  gen("move.l",addrbuf,"a0");  /* abs address of store */
  460.                     gen("move.w","d0","(a0)");
  461.                }
  462.                else
  463.                /* ordinary variable */
  464.                     gen("move.w","d0",addrbuf);
  465.               }
  466.               else 
  467.               if (storage->object == array)
  468.              {
  469.               gen("move.w","d0","_short_input_temp");
  470.               point_to_array(storage,addrbuf);
  471.               gen("move.w","_short_input_temp","0(a2,d7.L)");
  472.               enter_BSS("_short_input_temp:","ds.w 1");
  473.              }
  474.  
  475.                enter_XREF("_finputshort");
  476.               break;
  477.  
  478.     case longtype   : gen("jsr","_finputlong","  ");
  479.  
  480.               if (storage->object == variable)
  481.               {
  482.                if ((storage->shared) && (lev == ONE))
  483.                {
  484.                  gen("move.l",addrbuf,"a0");  /* abs address of store */
  485.                     gen("move.l","d0","(a0)");
  486.                }
  487.                else
  488.                /* ordinary variable */
  489.                     gen("move.l","d0",addrbuf);
  490.               }
  491.               else 
  492.               if (storage->object == array)
  493.              {
  494.               gen("move.l","d0","_long_input_temp");
  495.               point_to_array(storage,addrbuf);
  496.               gen("move.l","_long_input_temp","0(a2,d7.L)");
  497.               enter_BSS("_long_input_temp:","ds.l 1");
  498.              }
  499.  
  500.               enter_XREF("_finputlong");
  501.               break;
  502.  
  503.     case singletype : gen("jsr","_finputsingle","  ");
  504.  
  505.               if (storage->object == variable)
  506.               {
  507.                if ((storage->shared) && (lev == ONE))
  508.                {
  509.                  gen("move.l",addrbuf,"a0");  /* abs address of store */
  510.                     gen("move.l","d0","(a0)");
  511.                }
  512.                else
  513.                /* ordinary variable */
  514.                     gen("move.l","d0",addrbuf);
  515.               }
  516.               else 
  517.               if (storage->object == array)
  518.              {
  519.               gen("move.l","d0","_long_input_temp");
  520.               point_to_array(storage,addrbuf);
  521.               gen("move.l","_long_input_temp","0(a2,d7.L)");
  522.               enter_BSS("_long_input_temp:","ds.l 1");
  523.              }
  524.  
  525.               enter_XREF("_finputsingle");
  526.               enter_XREF("_MathBase"); /* need math libs */
  527.               enter_XREF("_MathTransBase");
  528.               break;
  529.  
  530.     case stringtype : gen("jsr","_finputstring","  ");
  531.  
  532.               gen("move.l","a0","-(sp)"); 
  533.  
  534.               if (storage->object == variable)
  535.                   assign_to_string_variable(storage,MAXSTRLEN);
  536.               else 
  537.               if (storage->object == array)
  538.              {
  539.               point_to_array(storage,addrbuf);
  540.               assign_to_string_array(addrbuf);
  541.              }
  542.  
  543.               enter_XREF("_finputstring");
  544.               break;
  545.     }
  546.    } else _error(19);
  547.  
  548.    insymbol();
  549.    if (sym == lparen && storage->object != array)
  550.       _error(71);  /* undeclared array */
  551.   }
  552.   while (sym == comma);
  553.  }
  554. }
  555.  
  556. void kill()
  557. {
  558. /* KILL <filespec> */
  559.  
  560.  check_for_event();
  561.  
  562.  insymbol();
  563.  if (expr() != stringtype) _error(4);
  564.  else
  565.  {
  566.   gen("move.l","(sp)+","d1");
  567.   gen("jsr","_kill","  ");
  568.   enter_XREF("_kill");
  569.  }
  570. }
  571.  
  572. void rename()
  573. {
  574. /* NAME <filespec1> AS <filespec2> */
  575.  
  576.  check_for_event();
  577.  
  578.  insymbol();
  579.  if (expr() != stringtype) _error(4);
  580.  else
  581.  {
  582.   if (sym != assym) _error(72);
  583.   else
  584.   {
  585.    insymbol();
  586.    if (expr() != stringtype) _error(4);
  587.    else
  588.    {
  589.     gen("move.l","(sp)+","d2");  /* <filespec2> */
  590.     gen("move.l","(sp)+","d1");  /* <filespec1> */
  591.     gen("jsr","_rename","  ");
  592.     enter_XREF("_rename");
  593.    }
  594.   }
  595.  }
  596. }
  597.  
  598. void chdir()
  599. {
  600. /* CHDIR <dirname> */
  601.  
  602.  check_for_event();
  603.  
  604.  insymbol();
  605.  
  606.  if (expr() != stringtype) _error(4);
  607.  else
  608.  {
  609.   /* call code to change directory */
  610.   gen("move.l","(sp)+","d1");  /* dirname */
  611.   gen("jsr","_chdir","  ");
  612.   enter_XREF("_chdir");
  613.  }
  614. }
  615.  
  616. void files()
  617. {
  618. /* FILES [TO <storefile>] [,<target>] */
  619.  
  620.  check_for_event();
  621.  
  622.  insymbol();
  623.  
  624.  /* storage file specified? */
  625.  if (sym == tosym)
  626.  {
  627.   insymbol();
  628.   if (expr() != stringtype) _error(4);
  629.  }
  630.  else
  631.      gen("move.l","#0","-(sp)");  /* NULL for storage file name */
  632.       
  633.  /* target file or directory specified? */
  634.  if (sym == comma)
  635.  {
  636.   insymbol();
  637.   if (expr() != stringtype) _error(4);
  638.  }
  639.  else
  640.      gen("move.l","#0","-(sp)");  /* NULL for target name */
  641.  
  642.  /* call _files routine */
  643.  gen("jsr","_files","  ");
  644.  gen("addq","#4","sp");
  645.  enter_XREF("_files");
  646. }
  647.  
  648. char *push_struct_var_info(structVar)
  649. SYM *structVar;
  650. {
  651. char addrbuf[40], sizebuf[10];
  652.  
  653.     /*
  654.     ** Push address held by structure variable.
  655.     */
  656.     sprintf(addrbuf,"%d%s",-1*structVar->address, frame_ptr[lev]);
  657.     if (structVar->shared && lev == ONE)
  658.     {
  659.         /*
  660.         ** Shared structure variable.
  661.         */
  662.         gen("movea.l",addrbuf,"a0");    /* struct variable address */
  663.         gen("move.l","(a0)","-(sp)");    /* start address of struct */
  664.     }
  665.     else
  666.         /*
  667.         ** Local structure variable,
  668.         ** ie. in main program or SUB.
  669.         */
  670.         gen("move.l",addrbuf,"-(sp)");    /* variable holds start address */
  671.  
  672.     /*
  673.     ** Push size of structure in bytes.
  674.     */
  675.     sprintf(sizebuf,"#%d",structVar->other->size);
  676.     gen("move.l",sizebuf,"-(sp)");
  677. }
  678.  
  679. void random_file_get()
  680. {
  681. /*
  682. ** Fill a structure from a random file.
  683. **
  684. ** SYNTAX: GET [#]fileNum, structVar [, recordNum]
  685. */
  686. SYM *structVar;
  687.  
  688.     check_for_event(); 
  689.     
  690.     /* 
  691.     ** We already have the first symbol.
  692.     ** Skip `#' if present.
  693.     */
  694.     if (sym == hash) insymbol();
  695.     
  696.     /*
  697.     ** Get the file number.
  698.     */
  699.      if (make_integer(expr()) == shorttype)
  700.             make_long();    /* filenumber 1..255 */
  701.  
  702.      if (sym != comma) _error(16);
  703.      else
  704.      {
  705.         /*
  706.         ** Structure variable address and size.
  707.         */
  708.         insymbol();
  709.         if (!exist(id,structure)) _error(79);
  710.         else
  711.         {
  712.             structVar = curr_item;
  713.             push_struct_var_info(structVar);
  714.  
  715.             insymbol();
  716.             if (sym == comma)
  717.             {
  718.                 /*
  719.                 ** Optional record number.
  720.                 */
  721.                 insymbol();
  722.                  if (make_integer(expr()) == shorttype)
  723.                         make_long();    /* record number >= 1 */
  724.             }
  725.             else
  726.                 /*
  727.                 ** Tell library function not to
  728.                 ** seek to a particular record 
  729.                 ** before reading.
  730.                 */
  731.                 gen("move.l","#0","-(sp)");
  732.  
  733.             /*
  734.             ** Call function.
  735.             */
  736.             gen("jsr","_GetRecord","  ");
  737.              gen("add.l","#16","sp");
  738.             enter_XREF("_GetRecord");
  739.         }
  740.     }    
  741. }
  742.  
  743. void random_file_put()
  744. {
  745. /*
  746. ** Write a structure to a random file.
  747. **
  748. ** SYNTAX: PUT [#]fileNum, structVar [, recordNum]
  749. */
  750. SYM *structVar;
  751.  
  752.     check_for_event(); 
  753.     
  754.     /* 
  755.     ** We already have the first symbol.
  756.     ** Skip `#' if present.
  757.     */
  758.     if (sym == hash) insymbol();
  759.     
  760.     /*
  761.     ** Get the file number.
  762.     */
  763.      if (make_integer(expr()) == shorttype)
  764.             make_long();    /* filenumber 1..255 */
  765.  
  766.      if (sym != comma) _error(16);
  767.      else
  768.      {
  769.         /*
  770.         ** Structure variable address and size.
  771.         */
  772.         insymbol();
  773.         if (!exist(id,structure)) _error(79);
  774.         else
  775.         {
  776.             structVar = curr_item;
  777.             push_struct_var_info(structVar);
  778.  
  779.             insymbol();
  780.             if (sym == comma)
  781.             {
  782.                 /*
  783.                 ** Optional record number.
  784.                 */
  785.                 insymbol();
  786.                  if (make_integer(expr()) == shorttype)
  787.                         make_long();    /* record number >= 1 */
  788.             }
  789.             else
  790.                 /*
  791.                 ** Tell library function not to
  792.                 ** seek to a particular record 
  793.                 ** before writing.
  794.                 */
  795.                 gen("move.l","#0","-(sp)");
  796.  
  797.             /*
  798.             ** Call function.
  799.             */
  800.             gen("jsr","_PutRecord","  ");
  801.              gen("add.l","#16","sp");
  802.             enter_XREF("_PutRecord");
  803.         }
  804.     }    
  805. }
  806.